home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / TPPDMENU / TPPDMENU.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-11  |  32KB  |  960 lines

  1. {$S-,R-,V-,I-,B-,F-}
  2.  
  3. {$IFDEF Ver40}
  4.   {$F-}
  5. {$ELSE}
  6. {$F+}
  7. {$I OPLUS.INC}
  8. {$ENDIF}
  9.  
  10. {$IFDEF Debug}
  11.   {$D+}
  12. {$ENDIF}
  13.  
  14. {Conditional defines that may affect this unit}
  15. {$I TPDEFINE.INC}
  16.  
  17. {*********************************************************}
  18. {*                  TPPDMENU.PAS 5.06                    *}
  19. {*          Copyright (c) Ken Henderson 1989, 1990.      *}
  20. {*                                                       *}
  21. {*                                                       *}
  22. {*                                                       *}
  23. {*********************************************************}
  24.  
  25. unit TpPdmenu;
  26.   {-Pulldown menu systems}
  27.  
  28. interface
  29.  
  30. uses
  31.   TpCrt,                          {Turbo Professional CRT unit}
  32.   Dos,                            {DOS interface - standard unit}
  33.   {$IFDEF UseMouse}
  34.   TpMouse,                        {Turbo Professional mouse routines}
  35.   TpPdMous,                       {Mouse support for TpPdMenu}
  36.   {$ENDIF}
  37.   TpWindow,                       {Turbo Professional popup window management}
  38.   TpString;                       {Turbo Professional string handling routines}
  39.  
  40. const
  41.   MaxMenuDepth             = 3;   {Maximum depth of menus}
  42.   MaxSelections            = 20;  {Maximum number of selections in one menu}
  43.   Null                     = #0;
  44.   OnOff                    : array[Boolean] of String[3] = ('ON ', 'OFF');
  45.  
  46. type
  47.   ColorType =                     {Screen colors}
  48.   (TextColor,                     {Normal menu color}
  49.    FrameColor,                    {Menu frame color}
  50.    SelectColor,                   {Selected menu item color}
  51.    HighLightColor                 {Highlighted selection character in menu}
  52.    );
  53.  
  54.   {Stores screen attributes}
  55.   MenuAttributeArray       = array[ColorType] of Byte;
  56.  
  57.   {-Types to define user parameters}
  58.   UserHelpType             = procedure(OptionIndex : Integer);
  59.   UserValidationType       = function(OptionIndex : Integer) : Boolean;
  60.   UserEvaluateType         = procedure(C : Integer; Stat : Byte; var S : String);
  61.  
  62.   {-Array to store menu data in, (size is arbitrary)}
  63.   InitArray                = array[1..4096] of Byte;
  64.   InitArrayPtr             = ^InitArray;
  65.  
  66.   {-Definitions for pulldown menu system}
  67.   MenuOrientation          = (Horizontal, Vertical); {Horizontal or vertical scrolling menus}
  68.  
  69.   MenuDescriptor =
  70.     record
  71.       Orientation              : MenuOrientation; {Horizontal or vertical}
  72.       Overlap                  : WindowPtr; {Points to buffer holding what it covers}
  73.     end;
  74.  
  75.   Menulevels               = array[1..MaxMenuDepth] of MenuDescriptor;
  76.  
  77.   Menuptr                  = ^Menurecord;
  78.  
  79.   SubMenuRecord =                 {12 bytes}
  80.     record
  81.       Command                  : Integer; {Command returned via selection}
  82.       Doffset                  : Byte; {Rows or cols offset for prompt within window}
  83.       StatVal                  : Byte; {Indicates whether entry display also has status info}
  84.       Soffset                  : Byte; {Offset into prompt of Select char (for highlight)}
  85.       Prompt                   : ^String; {Points to string displayed for menu item}
  86.       SubMenu                  : Menuptr; {Points to submenu if any}
  87.     end;
  88.  
  89.   SubArray                 = array[1..MaxSelections] of SubMenuRecord;
  90.  
  91.   Menurecord =                    {12 bytes}
  92.     record
  93.       MenuLev                  : Byte; {Depth of this menu, points into MenuDescriptor array}
  94.       XPosn                    : Byte; {X upper left. not border, but text position}
  95.       YPosn                    : Byte; {Y upper left. not border, but text position}
  96.       XSize                    : Byte; {Number of characters of text}
  97.       YSize                    : Byte; {Number of lines of text}
  98.       SubMax                   : Byte; {Number of selections or submenus}
  99.       SubCur                   : Byte; {Currently active submenu or selection}
  100.       SubOn                    : Boolean; {True if submenu is simultaneously displayed}
  101.       SubMenus                 : ^SubArray; {Points to array of selections}
  102.     end;
  103.  
  104. var
  105.   MenuDesc                 : Menulevels; {General specification of each menu level}
  106.   RootMenu                 : Menuptr; {The menu that starts it all}
  107.   CurrMenu                 : Menuptr; {Currently active menu}
  108.   ExitMenu                 : Boolean; {False to loop within menu system}
  109.   MenuDataSize, MenuResult : Integer; {Menu data file size and array dimension, Result of initmenus}
  110.   P                        : InitArrayPtr; {Pointer to menu data area}
  111.  
  112.   ScreenAttr               : MenuAttributeArray; {-Global to store colors passed to init routine}
  113.   UserHelp                 : UserHelpType; {-User defined help routine when F1 is pressed}
  114.   UserValidation           : UserValidationType; {-User defined routine to validate
  115.                                           access to a menu item}
  116.   UserExitMenus            : UserValidationType; {-Allow exit from the menu system}
  117.   UserEvaluateSpecial      : UserEvaluateType; {-User defined routine to allow
  118.                                             display of variables on menus}
  119.   ToggleBoolean            : Integer; {-Allows pressing space or backspace to force a
  120.                             boolean variable to ON or OFF, respectively.
  121.                             0=no change,
  122.                             1=force to OFF,
  123.                             2=force to ON
  124.                             Check it on return from the menu system and set
  125.                             your variable accordingly}
  126.  
  127. procedure GetMenuChoice(var Cmd : Integer; var ExitMenu : Boolean);
  128.   {-Display the menu system, and get a selection}
  129.  
  130. function InitMenus(MenuName : String; ColorTable : MenuAttributeArray;
  131.                    UserDefinedHelpPtr,
  132.                    UserDefinedValidationPtr,
  133.                    UserdefinedEvaluatePtr,
  134.                    UserDefinedExitMenusPtr,
  135.                    BuiltInMenuAddress       : Pointer) : Integer;
  136.  
  137. procedure ToggleBooleanVal(var InBoolean : Boolean);
  138.   {-A routine to force the state of a boolean variable based on the value of
  139.     the global ToggleBoolean variable.  This allows you, for instance, to
  140.     build keyboard macros that set the state of a boolean variable in the
  141.     menu system without first knowing the variable's value.}
  142.   {==========================================================================}
  143.  
  144. implementation
  145.  
  146.   procedure ToggleBooleanVal(var InBoolean : Boolean);
  147.   {-A routine to force the state of a boolean variable based on the value of
  148.     the global ToggleBoolean variable.  This allows you, for instance, to
  149.     build keyboard macros that set the state of a boolean variable in the
  150.     menu system without first knowing the variable's value.}
  151.  
  152.   begin
  153.     case ToggleBoolean of
  154.       2 : InBoolean := True;      {Force it to ON}
  155.       1 : InBoolean := False;     {Force it to OFF}
  156.     else
  157.       InBoolean := not(InBoolean); {Otherwise, just toggle it}
  158.     end;
  159.     ToggleBoolean := 0;
  160.   end;
  161.  
  162.   procedure DrawItem(Menu : Menuptr; sub : Byte);
  163.     {-Draw menu item "sub" of the chosen menu}
  164.   const
  165.     {Flags used for status display in menu system}
  166.     NoStat                   = 0; {Entry displays no status}
  167.     BoolStat                 = 1; {Entry displays boolean - ON/OFF - status}
  168.     NumStat                  = 2; {Entry displays numeric status}
  169.     StrStat                  = 3; {Entry displays string status}
  170.   var
  171.     R, C, Len                : Byte;
  172.     S                        : String;
  173.     Orient                   : MenuOrientation;
  174.  
  175.   begin                           {DrawItem}
  176.  
  177.     {Get the orientation of the current menu}
  178.     Orient := MenuDesc[Menu^.MenuLev].Orientation;
  179.  
  180.     with Menu^, SubMenus^[sub] do 
  181.     begin
  182.  
  183.       {Copy the prompt to a work string}
  184.       Len := Ord(Prompt^[0]);
  185.       R := YPosn;
  186.       C := XPosn;
  187.  
  188.       {Pad with blanks left and right}
  189.       if Orient = Vertical then 
  190.       begin
  191.         S[0] := Chr(XSize);
  192.         R := R+Doffset;
  193.       end 
  194.       else 
  195.       begin
  196.         S[0] := Chr(Len+2);
  197.         C := C+Doffset;
  198.       end;
  199.  
  200.       FillChar(S[1], Length(S), #32);
  201.       Move(Prompt^[1], S[2], Len);
  202.  
  203.       if StatVal <> NoStat then
  204.         {Special cases to display status items, etc}
  205.         if @UserEvaluateSpecial <> nil then
  206.           UserEvaluateSpecial(Command, StatVal, S);
  207.  
  208.       if (@UserValidation <> nil) then
  209.       begin
  210.         if (Menu^.SubCur <> sub) then
  211.         begin
  212.           if (UserValidation(Command)) then
  213.           begin
  214.             {Write item with highlighted selection character}
  215.             FastWrite(Copy(S, 1, Soffset), R, C, ScreenAttr[TextColor]);
  216.             FastWrite(S[Succ(Soffset)], R, C+Soffset, ScreenAttr[HighLightColor]);
  217.             FastWrite(Copy(S, Soffset+2, Length(S)), R, Succ(C+Soffset), ScreenAttr[TextColor]);
  218.           end 
  219.           else FastWrite(S, R, C, ScreenAttr[TextColor])
  220.         end 
  221.         else
  222.           {Write the selected prompt}
  223.           FastWrite(S, R, C, ScreenAttr[SelectColor]);
  224.       end 
  225.       else
  226.       begin
  227.         if Menu^.SubCur <> sub then
  228.         begin
  229.           {Write item with highlighted selection character}
  230.           FastWrite(Copy(S, 1, Soffset), R, C, ScreenAttr[TextColor]);
  231.           FastWrite(S[Succ(Soffset)], R, C+Soffset, ScreenAttr[HighLightColor]);
  232.           FastWrite(Copy(S, Soffset+2, Length(S)), R, Succ(C+Soffset), ScreenAttr[TextColor]);
  233.         end 
  234.         else
  235.           {Write the selected prompt}
  236.           FastWrite(S, R, C, ScreenAttr[SelectColor]);
  237.       end;
  238.     end;
  239.   end;                            {DrawItem}
  240.  
  241.   procedure UndrawMenu(Menu : Menuptr);
  242.     {-remove the menu and its children from the screen}
  243.  
  244.   begin                           {Undrawmenu}
  245.  
  246.     if Menu = nil then
  247.       Exit;
  248.  
  249.     with Menu^ do 
  250.     begin
  251.       {Undraw any submenus - must do first to get proper screen restore}
  252.       if SubOn then 
  253.       begin
  254.         UndrawMenu(SubMenus^[SubCur].SubMenu);
  255.         SubOn := False;
  256.       end;
  257.  
  258.       with MenuDesc[MenuLev] do
  259.         {Restore whatever the menu overlapped on the screen}
  260.         DisposeWindow(EraseTopWindow);
  261.     end;
  262.   end;                            {Undrawmenu}
  263.  
  264.   procedure EraseMenus;
  265.     {-Remove the menu system from the screen}
  266.  
  267.   begin                           {EraseMenus}
  268.     UndrawMenu(RootMenu);
  269.     CurrMenu := nil;
  270.     NormalCursor;
  271.   end;                            {EraseMenus}
  272.  
  273.   procedure DrawMenu(Menu : Menuptr);
  274.     {-Draw a menu and its selected children on the screen}
  275.   var
  276.     I                        : Byte;
  277.     S                        : String;
  278.  
  279.   begin                           {DrawMenu}
  280.  
  281.     if Menu = nil then
  282.       Exit;
  283.  
  284.     with Menu^ do 
  285.     begin
  286.  
  287.       with MenuDesc[MenuLev] do 
  288.       begin
  289.         {Create a window to contain the menu}
  290.         if MakeWindow(Overlap, Pred(XPosn), Pred(YPosn), XPosn+XSize, YPosn+YSize, True, True, True,
  291.                       ScreenAttr[TextColor], ScreenAttr[FrameColor], ScreenAttr[FrameColor], '') then
  292.           if DisplayWindow(Overlap) then ; {You may wish to put some error trapping here}
  293.       end;
  294.  
  295.       {Draw each item in the menu}
  296.       for I := 1 to SubMax do
  297.         DrawItem(Menu, I);
  298.  
  299.       {Draw any submenus}
  300.       if SubOn then
  301.         DrawMenu(SubMenus^[SubCur].SubMenu);
  302.  
  303.     end;
  304.   end;                            {Drawmenu}
  305.  
  306.  
  307.   procedure GetMenuChoice(var Cmd : Integer; var ExitMenu : Boolean);
  308.     {-Display the menu system, and get a selection}
  309.   type
  310.     {Available commands when menu selection is being made}
  311.     MenuCommandType          = (Mup, Mdown, Mright, Mleft, Mesc, Msel, Mhelp, Mnul);
  312.   var
  313.     Ch                       : Char;
  314.     Mcmd                     : MenuCommandType;
  315.     Done                     : Boolean;
  316.     sub                      : Byte;
  317.  
  318.     function MenuCommand(CurrMenu                 : Menuptr;
  319.                          var Ch                   : Char;
  320.                          var Mcmd                 : MenuCommandType) : Boolean;
  321.       {-Return a menucommand or a character}
  322.     type
  323.       str1                     = String[1];
  324.       str2                     = String[2];
  325.     const
  326.       WScommands               : String[6] = ^@^D^E^S^X^J;
  327.       EXcommands               : String[5] = 'MHKP;';
  328.     var
  329.       Orient                   : MenuOrientation;
  330.       Lev                      : Integer;
  331.       nullstr                  : str1;
  332.       pushstr                  : str2;
  333.       PushWord                 : Word;
  334.  
  335.     begin                         {MenuCommand}
  336.       nullstr := '';
  337.       pushstr := '';
  338.       MenuCommand := True;
  339.       {Get the orientation of the current menu}
  340.       Lev := CurrMenu^.MenuLev;
  341.       Orient := MenuDesc[Lev].Orientation;
  342.       Mcmd := Mnul;
  343.       Ch := Readkey;
  344.       if Ch = Null then           {possibly attempted to press a hot key}
  345.       begin
  346.         {Extended character, get other half and convert to WS format}
  347.         Ch := Readkey;
  348.         pushstr := Null+Ch;
  349.         Ch := WScommands[Succ(Pos(Ch, EXcommands))];
  350.       end;
  351.  
  352.       case Ch of
  353.         ^J :                      {F1}
  354.           Mcmd := Mhelp;
  355.         ^E :                      {Up arrow}
  356.           if Orient = Vertical then
  357.             Mcmd := Mup;
  358.         ^X :                      {Down arrow}
  359.           if Lev = 1 then
  360.             Mcmd := Msel
  361.           else if Orient = Vertical then
  362.             Mcmd := Mdown;
  363.         ^S :                      {Left arrow}
  364.           if Lev <= 2 then
  365.             Mcmd := Mleft;
  366.         ^D :                      {Right arrow}
  367.           if Lev <= 2 then
  368.             Mcmd := Mright;
  369.         ^M :                      {Enter}
  370.           Mcmd := Msel;
  371.         #32 : if CurrMenu^.SubMenus^[CurrMenu^.SubCur].StatVal = 1 then {Space}
  372.               begin
  373.                 ToggleBoolean := 2;
  374.                 Mcmd := Msel;
  375.               end;
  376.         ^H : if CurrMenu^.SubMenus^[CurrMenu^.SubCur].StatVal = 1 then {Backspace}
  377.              begin
  378.                ToggleBoolean := 1;
  379.                Mcmd := Msel;
  380.              end;
  381.         ^[ :                      {Esc}
  382.           Mcmd := Mesc;
  383.       else
  384.         {Probably not a menu command -- this code allows hooks to hot keys}
  385.  
  386.         {If a key which begins with a null, yet is not a valid menu command,
  387.         is pressed, this routine exits the menu system and puts the key into
  388.         the keyboard buffer to be processed by the calling routine}
  389.         MenuCommand := False;
  390.         {$IFDEF AllowHotKeys}
  391.         begin
  392.           if pushstr='' then MenuCommand := false
  393.           else
  394.           begin
  395.             MenuCommand := true;
  396.             Mcmd:=Mesc;     {Exit the menus}
  397.             Move(PushStr[1],PushWord,2);
  398.             StuffKey(pushword);
  399.           end;
  400.         end;
  401.         {$ENDIF}
  402.       end;
  403.     end;                          {MenuCommand}
  404.  
  405.     function MenuSelection(CurrMenu : Menuptr; Ch : Char; var sub : Byte) : Boolean;
  406.       {-Return true and a submenu number if ch matches a select character}
  407.     var
  408.       Found                    : Boolean;
  409.  
  410.     begin                         {MenuSelection}
  411.       with CurrMenu^ do 
  412.       begin
  413.         Ch := Upcase(Ch);
  414.         sub := 1;
  415.         Found := False;
  416.         while not(Found) and (sub <= SubMax) do 
  417.         begin
  418.           with SubMenus^[sub] do
  419.             if @UserValidation <> nil then
  420.             begin
  421.               Found := (UserValidation(Command)) and
  422.               (Upcase(Prompt^[Soffset]) = Ch);
  423.             end 
  424.             else Found := (Upcase(Prompt^[Soffset]) = Ch);
  425.           if not(Found) then
  426.             Inc(sub);
  427.         end;
  428.       end;
  429.       MenuSelection := Found;
  430.     end;                          {MenuSelection}
  431.  
  432.     procedure UpdateItem(Menu : Menuptr; SubLast, SubCur : Byte);
  433.       {-Highlight the current menu item}
  434.  
  435.     begin                         {UpdateItem}
  436.       DrawItem(Menu, SubLast);
  437.       DrawItem(Menu, SubCur);
  438.     end;                          {UpdateItem}
  439.  
  440.     procedure DecCurSubmenu(Menu : Menuptr);
  441.       {-Move to the previous selection, and wrap}
  442.     var
  443.       SubLast                  : Byte;
  444.  
  445.     begin                         {DecCurSubmenu}
  446.       with Menu^ do 
  447.       begin
  448.         SubLast := SubCur;
  449.         if @UserValidation <> nil then
  450.         begin
  451.           repeat
  452.             if SubCur > 1 then
  453.               Dec(SubCur)
  454.             else
  455.               SubCur := SubMax;
  456.           until UserValidation(SubMenus^[SubCur].Command);
  457.         end 
  458.         else
  459.         begin
  460.           if SubCur > 1 then
  461.             Dec(SubCur)
  462.           else
  463.             SubCur := SubMax;
  464.         end;
  465.         UpdateItem(Menu, SubLast, SubCur);
  466.       end;
  467.     end;                          {DecCurSubmenu}
  468.  
  469.     procedure IncCurSubmenu(Menu : Menuptr);
  470.       {-Move to the next selection, and wrap}
  471.     var
  472.       SubLast                  : Byte;
  473.  
  474.     begin                         {IncCurSubmenu}
  475.       with Menu^ do 
  476.       begin
  477.         SubLast := SubCur;
  478.         if @UserValidation <> nil then
  479.         begin
  480.           repeat
  481.             if SubCur < SubMax then
  482.               Inc(SubCur)
  483.             else
  484.               SubCur := 1;
  485.           until UserValidation(SubMenus^[SubCur].Command);
  486.         end 
  487.         else
  488.         begin
  489.           if SubCur < SubMax then
  490.             Inc(SubCur)
  491.           else
  492.             SubCur := 1;
  493.         end;
  494.         UpdateItem(Menu, SubLast, SubCur);
  495.       end;
  496.     end;                          {IncCurSubmenu}
  497.  
  498.     procedure SetInitSelection(CurrMenu : Menuptr);
  499.       {-Assure initial menu selection is accessible}
  500.  
  501.     begin                         {SetInitSelection}
  502.       with CurrMenu^ do 
  503.       begin
  504.         if SubCur < 1 then
  505.           SubCur := 1;
  506.         if @UserValidation <> nil then
  507.         begin
  508.           while not(UserValidation(SubMenus^[SubCur].Command)) do
  509.             if SubCur < SubMax then
  510.               Inc(SubCur)
  511.             else
  512.               SubCur := 1;
  513.         end;
  514.       end;
  515.     end;                          {SetInitSelection}
  516.  
  517.     function EvaluateMenuCommand(var CurrMenu             : Menuptr;
  518.                                  Mcmd                     : MenuCommandType;
  519.                                  var Cmd                  : Integer) : Boolean;
  520.       {-Change current selection and current menu as indicated}
  521.     var
  522.       Done                     : Boolean;
  523.       Ch                       : Char;
  524.  
  525.     begin
  526.       Done := False;
  527.  
  528.       case Mcmd of
  529.  
  530.         Mleft :
  531.           begin
  532.             {Move the root menu selection left}
  533.             DecCurSubmenu(RootMenu);
  534.             if CurrMenu <> RootMenu then 
  535.             begin
  536.               UndrawMenu(CurrMenu);
  537.               with RootMenu^ do
  538.                 CurrMenu := SubMenus^[SubCur].SubMenu;
  539.               SetInitSelection(CurrMenu);
  540.               DrawMenu(CurrMenu);
  541.             end;
  542.           end;
  543.  
  544.         Mright :
  545.           begin
  546.             {Move the root menu selection right}
  547.             IncCurSubmenu(RootMenu);
  548.             if CurrMenu <> RootMenu then 
  549.             begin
  550.               UndrawMenu(CurrMenu);
  551.               with RootMenu^ do
  552.                 CurrMenu := SubMenus^[SubCur].SubMenu;
  553.               SetInitSelection(CurrMenu);
  554.               DrawMenu(CurrMenu);
  555.             end;
  556.           end;
  557.  
  558.         Mup :
  559.           {Move the current menu selection up}
  560.           DecCurSubmenu(CurrMenu);
  561.  
  562.         Mdown :
  563.           {Move the current menu selection down}
  564.           IncCurSubmenu(CurrMenu);
  565.  
  566.         Mesc :
  567.           if CurrMenu = RootMenu then 
  568.           begin
  569.             {Leave the menu system}
  570.             Done := True;
  571.             EraseMenus;
  572.             Cmd := 0;
  573.           end 
  574.           else 
  575.           begin
  576.             UndrawMenu(CurrMenu);
  577.             if CurrMenu^.MenuLev = 2 then
  578.               {Move back to the root menu}
  579.               CurrMenu := RootMenu
  580.             else
  581.               with RootMenu^ do
  582.                 {Move back to level 2}
  583.                 CurrMenu := SubMenus^[SubCur].SubMenu;
  584.             CurrMenu^.SubOn := False;
  585.           end;
  586.  
  587.         Msel :
  588.           with CurrMenu^ do
  589.             if SubMenus^[SubCur].SubMenu <> nil then 
  590.             begin
  591.               {Another menu below, display it and move to it}
  592.               SubOn := True;
  593.               CurrMenu := SubMenus^[SubCur].SubMenu;
  594.               SetInitSelection(CurrMenu);
  595.               DrawMenu(CurrMenu);
  596.             end 
  597.             else 
  598.             begin
  599.               {Bottom level menu, return a command}
  600.               Done := True;
  601.               Cmd := SubMenus^[SubCur].Command;
  602.               if @UserExitMenus <> nil then
  603.               begin
  604.                 if UserExitMenus(Cmd) then EraseMenus;
  605.               end 
  606.               else EraseMenus;
  607.             end;
  608.         Mhelp : if @UserHelp <> nil then
  609.                   with CurrMenu^ do UserHelp(SubMenus^[SubCur].Command);
  610.       end;
  611.       EvaluateMenuCommand := Done;
  612.     end;                          {EvaluateMenuCommand}
  613.  
  614.     function EvaluateSelectionCommand(var CurrMenu             : Menuptr;
  615.                                       sub                      : Byte;
  616.                                       var Cmd                  : Integer) : Boolean;
  617.       {-Select from the menu based on a prompt character}
  618.     var
  619.       Done                     : Boolean;
  620.       SubLast                  : Byte;
  621.  
  622.     begin                         {EvaluateSelectionCommand}
  623.       Done := False;
  624.       with CurrMenu^ do 
  625.       begin
  626.         SubLast := SubCur;
  627.         if SubMenus^[sub].SubMenu <> nil then 
  628.         begin
  629.           {Open up the selected submenu}
  630.           SubCur := sub;
  631.           SubOn := True;
  632.           {Update the screen}
  633.           UpdateItem(CurrMenu, SubLast, SubCur);
  634.           CurrMenu := SubMenus^[SubCur].SubMenu;
  635.           SetInitSelection(CurrMenu);
  636.           DrawMenu(CurrMenu);
  637.         end 
  638.         else 
  639.         begin
  640.           {Accept the command}
  641.           Done := True;
  642.           SubCur := sub;
  643.           {Update the screen}
  644.           UpdateItem(CurrMenu, SubLast, SubCur);
  645.           Cmd := SubMenus^[SubCur].Command;
  646.           if @UserExitMenus <> nil then
  647.           begin
  648.             if UserExitMenus(Cmd) then EraseMenus;
  649.           end 
  650.           else EraseMenus;
  651.         end;
  652.       end;
  653.       EvaluateSelectionCommand := Done;
  654.     end;                          {EvaluateSelectionCommand}
  655.  
  656.   begin                           {GetMenuChoice}
  657.     HiddenCursor;
  658.     ToggleBoolean := 0;
  659.     if CurrMenu = nil then
  660.       CurrMenu := RootMenu;
  661.  
  662.     {Set the initial menu selection to an acceptable one}
  663.     SetInitSelection(CurrMenu);
  664.  
  665.     if CurrMenu = RootMenu then
  666.       DrawMenu(CurrMenu)
  667.     else
  668.       {Menu already on screen, just update the items}
  669.       for sub := 1 to CurrMenu^.SubMax do
  670.         DrawItem(CurrMenu, sub);
  671.  
  672.     Done := False;
  673.  
  674.     repeat
  675.  
  676.       if MenuCommand(CurrMenu, Ch, Mcmd) then
  677.         {Move the cursor, escape, or select the current submenu}
  678.         Done := EvaluateMenuCommand(CurrMenu, Mcmd, Cmd)
  679.  
  680.       else if MenuSelection(CurrMenu, Ch, sub) then
  681.         {Select an entry by letter}
  682.         Done := EvaluateSelectionCommand(CurrMenu, sub, Cmd);
  683.  
  684.     until Done;
  685.  
  686.     ExitMenu := False;
  687.  
  688.   end;                            {GetMenuChoice}
  689.  
  690.   function InitMenus(MenuName : String; ColorTable : MenuAttributeArray;
  691.                      UserDefinedHelpPtr,
  692.                      UserDefinedValidationPtr,
  693.                      UserdefinedEvaluatePtr,
  694.                      UserDefinedExitMenusPtr,
  695.                      BuiltInMenuAddress       : Pointer) : Integer;
  696.     {-Set up the dynamic data structure of the menus}
  697.   var
  698.     br, InitPos, Smax, I     : Integer;
  699.     Tmenu                    : Menuptr;
  700.     cm                       : file;
  701.     UserDefinedHelp          : UserHelpType absolute UserDefinedHelpPtr;
  702.     UserDefinedValidation    : UserValidationType absolute UserDefinedValidationPtr;
  703.     UserdefinedEvaluate      : UserEvaluateType absolute UserdefinedEvaluatePtr;
  704.     UserDefinedExitMenus     : UserValidationType absolute UserDefinedExitMenusPtr;
  705.  
  706.     procedure InitMenuDesc(var MenuDesc : Menulevels);
  707.       {-Initialize general descriptions of each level of menu}
  708.  
  709.     begin                         {Initmenudesc}
  710.       with MenuDesc[1] do 
  711.       begin
  712.         Orientation := Horizontal;
  713.         Overlap := nil;
  714.       end;
  715.       with MenuDesc[2] do 
  716.       begin
  717.         Orientation := Vertical;
  718.         Overlap := nil;
  719.       end;
  720.       with MenuDesc[3] do 
  721.       begin
  722.         Orientation := Vertical;
  723.         Overlap := nil;
  724.       end;
  725.     end;                          {InitMenuDesc}
  726.  
  727.     function GetInitByte(P : InitArrayPtr; var InitPos : Integer) : Byte;
  728.       {-Return the next byte from the menu initialization data}
  729.  
  730.     begin                         {GetInitByte}
  731.       GetInitByte := P^[InitPos];
  732.       Inc(InitPos);
  733.     end;                          {GetInitByte}
  734.  
  735.     function InitMenu(P : InitArrayPtr; var InitPos, Smax : Integer; var Tmenu : Menuptr) : Integer;
  736.       {-Initialize the parameters of one menu level}
  737.     var
  738.       Lev, Xp, Yp, Xs, Ys      : Byte;
  739.       Smenu                    : Menuptr;
  740.  
  741.     begin                         {InitMenu}
  742.       InitMenu := 0;              {-assume success}
  743.       {Get the next six bytes from the initialization data}
  744.       Lev := GetInitByte(P, InitPos);
  745.       Xp := GetInitByte(P, InitPos);
  746.       Yp := GetInitByte(P, InitPos);
  747.       Xs := GetInitByte(P, InitPos);
  748.       Ys := GetInitByte(P, InitPos);
  749.       Smax := GetInitByte(P, InitPos);
  750.  
  751.       if Smax = 0 then
  752.         {No items in this menu}
  753.         Tmenu := nil
  754.       else 
  755.       begin
  756.         {Get the menu record and initialize it}
  757.         if MemAvail >= SizeOf(Menuptr) then New(Tmenu)
  758.         else
  759.         begin
  760.           InitMenu := -1;         {-Out of memory}
  761.           Exit;
  762.         end;
  763.         with Tmenu^ do 
  764.         begin
  765.           XPosn := Xp;
  766.           YPosn := Yp;
  767.           XSize := Xs;
  768.           YSize := Ys;
  769.           MenuLev := Lev;
  770.           SubMax := Smax;
  771.           SubCur := 0;
  772.           SubOn := False;
  773.           if MemAvail >= (SubMax*SizeOf(SubMenuRecord)) then
  774.             GetMem(SubMenus, SubMax*SizeOf(SubMenuRecord))
  775.           else
  776.           begin
  777.             InitMenu := -1;       {-Out of memory}
  778.             Exit;
  779.           end;
  780.         end;
  781.       end;
  782.  
  783.       case Lev of
  784.         1 : RootMenu := Tmenu;
  785.  
  786.         2 : if RootMenu = nil then
  787.             begin
  788.               InitMenu := -2;     {-Root menu must be specified first}
  789.               Exit;
  790.             end 
  791.             else
  792.               with RootMenu^ do 
  793.               begin
  794.                 Inc(SubCur);
  795.                 if SubCur > SubMax then
  796.                 begin
  797.                   InitMenu := -3; {-Too many submenus specified}
  798.                   Exit;
  799.                 end;
  800.                 SubMenus^[SubCur].SubMenu := Tmenu;
  801.               end;
  802.  
  803.         3 : if RootMenu = nil then
  804.             begin
  805.               InitMenu := -2;     {-Root menu must be specified first}
  806.               Exit;
  807.             end
  808.             else
  809.               with RootMenu^ do 
  810.               begin
  811.                 Smenu := RootMenu^.SubMenus^[RootMenu^.SubCur].SubMenu;
  812.                 if Smenu = nil then
  813.                 begin
  814.                   InitMenu := -2; {-Root menu must be specified first}
  815.                   Exit;
  816.                 end
  817.                 else
  818.                   with Smenu^ do 
  819.                   begin
  820.                     Inc(SubCur);
  821.                     if SubCur > SubMax then
  822.                     begin
  823.                       InitMenu := -3; {-Too many submenus specified}
  824.                       Exit;
  825.                     end;
  826.                     SubMenus^[SubCur].SubMenu := Tmenu;
  827.                   end;
  828.               end;
  829.  
  830.       else
  831.         begin
  832.           InitMenu := -4;         {-Error in level number in menu data file}
  833.           Exit;
  834.         end;
  835.       end;
  836.  
  837.     end;                          {InitMenu}
  838.  
  839.     procedure InitItem(P : InitArrayPtr; var InitPos : Integer;
  840.                        var sub                  : SubMenuRecord);
  841.       {-Initialize the parameters of one menu entry}
  842.     var
  843.       Scord, Cord, Dofs, Spec, Sofs : Byte;
  844.  
  845.     begin                         {Inititem}
  846.  
  847.       {Get the next four bytes from the initialization data}
  848.       Scord := GetInitByte(P, InitPos);
  849.       Cord := GetInitByte(P, InitPos);
  850.       Dofs := GetInitByte(P, InitPos);
  851.       Spec := GetInitByte(P, InitPos);
  852.       Sofs := GetInitByte(P, InitPos);
  853.  
  854.       {Store the record}
  855.       with sub do 
  856.       begin
  857.         Soffset := Succ(Sofs);    {String index where selection char is}
  858.         Doffset := Dofs;
  859.         StatVal := Spec;
  860.         Command := Cord+(Scord*256);
  861.         {Assume no deeper submenus}
  862.         SubMenu := nil;
  863.         {Store pointer to string}
  864.         Prompt := Ptr(Seg(P^), Ofs(P^)+Pred(InitPos));
  865.         {Skip over string}
  866.         InitPos := InitPos+Succ(P^[InitPos]);
  867.       end;
  868.  
  869.     end;                          {Inititem}
  870.  
  871.     procedure TraverseMenus(Menu : Menuptr);
  872.       {-Traverse the entire menu system, setting the current submenu to 1}
  873.     var
  874.       sub                      : Byte;
  875.       S                        : Menuptr;
  876.  
  877.     begin                         {TraverseMenu}
  878.       with Menu^ do 
  879.       begin
  880.         SubCur := 1;
  881.         for sub := 1 to SubMax do 
  882.         begin
  883.           S := SubMenus^[sub].SubMenu;
  884.           if S <> nil then
  885.             {Recursive call to traverse the next level}
  886.             TraverseMenus(S);
  887.         end;
  888.       end;
  889.     end;                          {TraverseMenu}
  890.  
  891.   begin                           {InitMenus}
  892.     {No root menu exists initially}
  893.     InitMenus := 0;               {-Assume success}
  894.     RootMenu := nil;
  895.  
  896.     {-Move passed parameters to globals we can keep around}
  897.     ScreenAttr := ColorTable;
  898.     UserHelp := UserDefinedHelp;
  899.     UserValidation := UserDefinedValidation;
  900.     UserEvaluateSpecial := UserdefinedEvaluate;
  901.     UserExitMenus := UserDefinedExitMenus;
  902.     {Initialize the menu descriptors for each menu level}
  903.     InitMenuDesc(MenuDesc);
  904.  
  905.     {Initialize menu data}
  906.     if MenuName <> '' then
  907.     begin
  908.       Assign(cm, MenuName);
  909.       Reset(cm, 1);
  910.       if IoResult <> 0 then
  911.       begin
  912.         P := nil;
  913.         InitMenus := -5;          {-Error opening the file}
  914.         Exit;
  915.       end 
  916.       else
  917.       begin
  918.         MenuDataSize := FileSize(cm);
  919.         GetMem(P, MenuDataSize);
  920.         BlockRead(cm, P^[1], MenuDataSize, br);
  921.         if IoResult <> 0 then
  922.         begin
  923.           InitMenus := -6;        {-Error reading the file}
  924.           Close(cm);
  925.           Exit;
  926.         end;
  927.         Close(cm);
  928.       end;
  929.     end 
  930.     else
  931.     begin
  932.       if BuiltInMenuAddress <> nil then P := BuiltInMenuAddress
  933.       else InitMenus := -5;       {-Error opening the file}
  934.     end;
  935.     InitPos := 1;
  936.  
  937.     repeat
  938.       {Initialize a menu group}
  939.       MenuResult := InitMenu(P, InitPos, Smax, Tmenu);
  940.       InitMenus := MenuResult;
  941.       if MenuResult <> 0 then Exit;
  942.       if Tmenu <> nil then
  943.       begin
  944.         {Initialize the entries for the menu group}
  945.         for I := 1 to Smax do
  946.           InitItem(P, InitPos, Tmenu^.SubMenus^[I]);
  947.       end;
  948.     until P^[InitPos] = $FF;
  949.  
  950.     {Set initial selections}
  951.     TraverseMenus(RootMenu);
  952.  
  953.     {No menu is currently displayed}
  954.     CurrMenu := nil;
  955.     ExitMenu := True;
  956.  
  957.   end;                            {InitMenus}
  958.  
  959. end.
  960.